home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 5 / Amiga Tools 5.iso / tools / developer-tools / andere sprachen / oberonv4 / oberon-src / system / opv.mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1995-12-10  |  27.9 KB  |  857 lines
  1. Syntax10.Scn.Fnt
  2. StampElems
  3. Alloc
  4. 10 Dec 95
  5. MODULE OPV;
  6. (* Control Module for the backend of the Oberon-2-Compiler for Sun-3.
  7.     Diplomarbeit Samuel Urech
  8.     Date: 30.10.92   Current version: 
  9.     IMPORT OPT, OPC, OPL, OPM;
  10.     CONST
  11.         (* object modes *)
  12.         Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7;
  13.         SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13;
  14.         (* opcodes *)
  15.         ASh = 0; LSh = 1; ROt = 3;
  16.         (* Condition codes *)
  17.         false = 1; true = 0;
  18.         CC = 4; CS = 5; EQ = 7; GE = 12; GT = 14; HI = 2; LE = 15;
  19.         LS = 3; LT = 13; MI = 11; NE = 6; PL = 10; VC = 8; VS = 9;
  20.         (* operation node subclasses *)
  21.         times = 1; slash = 2; div = 3; mod = 4;
  22.         and = 5; plus = 6; minus = 7; or = 8; eql = 9;
  23.         neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
  24.         in = 15; is = 16; ash = 17; msk = 18; len = 19;
  25.         conv = 20; abs = 21; cap = 22; odd = 23; not = 33;
  26.         (* SYSTEM *)
  27.         adr = 24; cc = 25; bit = 26; lsh = 27; rot = 28; val = 29;
  28.         (* structure forms *)
  29.         Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;
  30.         Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
  31.         Pointer = 13; ProcTyp = 14; Comp = 15;
  32.         (* composite structure forms *)
  33.         Basic = 1; Array = 2; DynArr = 3; Record = 4;
  34.         intSet = { SInt, Int, LInt }; realSet = { Real, LReal };
  35.         (* node classes *)
  36.         Nvar = 0; Nvarpar = 1; Nfield = 2; Nderef = 3; Nindex = 4; Nguard = 5; Neguard = 6;
  37.         Nconst = 7; Ntype = 8; Nproc = 9; Nupto = 10; Nmop = 11; Ndop = 12; Ncall = 13;
  38.         Ninittd = 14; Nif = 15; Ncaselse = 16; Ncasedo = 17; Nenter = 18; Nassign = 19;
  39.         Nifelse =20; Ncase = 21; Nwhile = 22; Nrepeat = 23; Nloop = 24; Nexit = 25;
  40.         Nreturn = 26; Nwith = 27; Ntrap = 28;
  41.         (* function numbers *)
  42.         assign = 0; newfn = 1; incfn = 13; decfn = 14;
  43.         inclfn = 15; exclfn = 16; copyfn = 18; assertfn = 32;
  44.         (* SYSTEM function numbers *)
  45.         getfn = 24; putfn = 25; getrfn = 26; putrfn = 27; sysnewfn = 30; movefn = 31;
  46.         VarParSize = OPM.PointerSize;
  47.         RecVarParSize = 2 * OPM.PointerSize;
  48.         ProcOff = 8;
  49.         (* procedure flags *)
  50.         hasBody = 1; isRedef = 2;
  51.         (* accessibility of objects *)
  52.         internal = 0; external = 1; externalR = 2;
  53.         (* trap numbers *)
  54.         WithTrap = 15;
  55.         CaseTrap = 16;
  56.         FuncTrap = 17;
  57.     VAR assert, findpc, typCheck : BOOLEAN;
  58.             loopEnd : OPL.Label;
  59.     PROCEDURE Init*( opt : SET; bpc : LONGINT );
  60.         CONST ass = 7; fpc = 8; typchk = 3;
  61.     BEGIN
  62.         typCheck := typchk IN opt;
  63.         assert := ass IN opt;
  64.         findpc := fpc IN opt;
  65.         IF findpc THEN OPM.breakpc := bpc ELSE OPM.breakpc := MAX( LONGINT ) END
  66.     END Init;
  67.     PROCEDURE Base( typ : OPT.Struct ) : INTEGER;
  68.     (* Returns the alignment of a type. *)
  69.     BEGIN
  70.         WHILE typ.comp = Array DO typ := typ.BaseTyp END;
  71.         IF typ.form IN { Byte, Bool, Char, SInt } THEN RETURN 1
  72.         ELSE RETURN 2
  73.         END
  74.     END Base;
  75.     PROCEDURE Align( VAR adr : LONGINT; base : LONGINT );
  76.     (* Aligns the given address with the given base. *)
  77.     BEGIN
  78.         IF adr > 0 THEN 
  79.             INC( adr, ( -adr ) MOD base );
  80.         ELSE
  81.             DEC( adr, adr MOD base );
  82.         END;
  83.     END Align;
  84.     PROCEDURE ^TypSize*( typ : OPT.Struct; dummy : BOOLEAN );
  85.     PROCEDURE ParamAdr( par : OPT.Object; VAR psize : LONGINT );
  86.     (* Calculates the sizes of the parameters of a procedure and returns their sum in psize. *)
  87.         VAR typ : OPT.Struct;
  88.                 c : INTEGER;
  89.     BEGIN (* ParamAdr *)
  90.         WHILE par # NIL DO
  91.             typ := par.typ; c := typ.comp;
  92.             TypSize( typ, FALSE );
  93.             IF par.mode = VarPar THEN
  94.                 par.adr := psize;
  95.                 IF c = Record THEN INC( psize, RecVarParSize )
  96.                 ELSIF c = DynArr THEN INC( psize, typ.size )
  97.                 ELSE INC( psize, VarParSize )
  98.                 END;
  99.             ELSE
  100.                 IF typ.form IN {Byte, Bool, Char, SInt, Int} THEN
  101.                     INC( psize, OPM.LIntSize );
  102.                 ELSE
  103.                     INC( psize, typ.size );
  104.                 END;
  105.                 par.adr := psize - typ.size;
  106.                 par.linkadr := par.adr;
  107.             END; (* IF *)
  108.             Align( psize, 4 ); (* all parameters are aligned to 4 bytes. *)
  109.             par := par.link;
  110.         END; (* WHILE *)
  111.     END ParamAdr;
  112.     PROCEDURE ^VarAdr( var : OPT.Object; VAR dsize : LONGINT );
  113.     PROCEDURE ^Traverse( obj : OPT.Object; exported : BOOLEAN );
  114.     PROCEDURE ProcSize( obj : OPT.Object; firstpass : BOOLEAN );
  115.     (* Writes the size of the local variables into the field obj.conval.intval and calculates the addresses of all parameters. *)
  116.         VAR oldPos : LONGINT;
  117.                 conval: OPT.Const;
  118.                 typ : OPT.Struct;
  119.                 redef : OPT.Object;
  120.     BEGIN (* ProcSize *)
  121.         conval := obj.conval;
  122.         oldPos := OPM.errpos;
  123.         OPM.errpos := obj.scope.adr;
  124.         IF ( ( obj.vis # internal ) = firstpass ) OR ( obj.mode = TProc ) THEN
  125.             obj.adr := -1;
  126.             obj.linkadr := OPL.NewLabel;
  127.             IF obj.mode IN { XProc, IProc, TProc } THEN
  128.                 IF OPL.entno < OPL.MaxEntry THEN
  129.                     obj.adr := OPL.entno;
  130.                     INC( OPL.entno );
  131.                 ELSE
  132.                     OPM.err( 226 );
  133.                     obj.adr := 1;
  134.                 END;
  135.             END;
  136.             IF obj.mnolev > 0 THEN
  137.                 conval.intval2 := ProcOff + OPM.PointerSize; (* for static link *)
  138.             ELSE
  139.                 conval.intval2 := ProcOff;
  140.             END;
  141.             ParamAdr( obj.link, conval.intval2 );
  142.             IF obj.mode = TProc THEN
  143.                 typ := obj.link.typ;
  144.                 IF typ.form = Pointer THEN typ := typ.BaseTyp END;
  145.                 OPT.FindField( obj.name, typ.BaseTyp, redef );
  146.                 IF redef # NIL THEN
  147.                     obj.adr := 10000H * ( redef.adr DIV 10000H ) (* mthno *) + obj.adr (* entno *);
  148.                     IF ~( isRedef IN obj.conval.setval ) THEN OPM.err( 134 ) END;
  149.                 ELSE
  150.                     INC( obj.adr, 10000H * typ.n );
  151.                     INC( typ.n );
  152.                 END; (* IF *)
  153.             END; (* IF *)
  154.         END; (* IF *)
  155.         IF ~firstpass THEN
  156.             IF ~( hasBody IN conval.setval ) THEN OPM.err( 129 ) END;
  157.             conval.intval := 0;
  158.             VarAdr( obj.scope.scope, conval.intval ); (* local variables *)
  159.             Traverse( obj.scope.right, FALSE ); (* local types and procedures *)
  160.         END;
  161.         OPM.errpos := oldPos
  162.     END ProcSize;
  163.     PROCEDURE TypSize*( typ : OPT.Struct; dummy : BOOLEAN );
  164.     (* Writes the size of a type into typ.size. All subordinate type sizes are calculated, all record fields get an offset. *)
  165.         VAR offset, size : LONGINT;
  166.                 fld : OPT.Object;
  167.                 btyp : OPT.Struct;
  168.     BEGIN (* TypSize *)
  169.         IF typ.size = -1 THEN
  170.             CASE typ.form OF
  171.                 Pointer : 
  172.                     typ.size := OPM.PointerSize;
  173.                     IF typ.BaseTyp = OPT.undftyp THEN
  174.                         OPM.Mark( 128, typ.n );
  175.                     ELSE
  176.                         TypSize( typ.BaseTyp, FALSE );
  177.                     END;
  178.                 | ProcTyp :
  179.                     size := ProcOff; typ.size := OPM.ProcSize;
  180.                     ParamAdr( typ.link, size ); (* inserts the addresses of the parameters. *)
  181.                 | Comp :
  182.                     CASE typ.comp OF
  183.                         Record :
  184.                             btyp := typ.BaseTyp;
  185.                             IF btyp = NIL THEN
  186.                                 offset := 0;
  187.                             ELSE
  188.                                 TypSize( btyp, FALSE );
  189.                                 offset := btyp.size;
  190.                             END;
  191.                             fld := typ.link;
  192.                             WHILE ( fld # NIL ) & ( fld.mode = Fld ) DO
  193.                                 btyp := fld.typ;
  194.                                 TypSize( btyp, FALSE );
  195.                                 size := btyp.size;
  196.                                 Align( offset, Base( btyp ) );
  197.                                 fld.adr := offset;
  198.                                 INC( offset, size );
  199.                                 fld := fld.link
  200.                             END; (* WHILE *)
  201.                             Align( offset, 2 ); (* all records are at least 2 Bytes long *)
  202.                             typ.size := offset;
  203.                         | Array :
  204.                             TypSize( typ.BaseTyp, FALSE ); 
  205.                             typ.size := typ.n * typ.BaseTyp.size;
  206.                         | DynArr :
  207.                             btyp := typ.BaseTyp;
  208.                             IF typ.offset < 0 THEN typ.offset := typ.n; END;
  209.                             IF btyp.comp = DynArr THEN btyp.offset := typ.n; END;
  210.                             TypSize( btyp, FALSE );
  211.                             IF btyp.comp = DynArr THEN
  212.                                 typ.size := btyp.size + 4;
  213.                             ELSE
  214.                                 typ.size := 8;
  215.                             END;
  216.                     END; (* CASE *)
  217.             ELSE (* nothing *)
  218.             END; (* CASE typ.form *)
  219.         END; (* IF *)
  220.     END TypSize;
  221.     PROCEDURE VarAdr( var : OPT.Object; VAR dsize : LONGINT );
  222.     (* Inserts entry-numbers and addresses into the variables. Exported variables are entered into the entry list. *)
  223.         VAR typ: OPT.Struct; adr: LONGINT;
  224.     BEGIN
  225.         adr := -dsize;
  226.         WHILE var # NIL DO
  227.             typ := var.typ;
  228.             TypSize( typ, FALSE );
  229.             DEC( adr, typ.size );
  230.             IF typ.form = Comp THEN
  231.                 Align( adr, 4 );
  232.             ELSE
  233.                 Align( adr, Base( typ ) );
  234.             END; (* IF *)
  235.             IF var.vis = internal THEN
  236.                 var.adr := adr;
  237.             ELSE
  238.                 OPL.SetEntry( OPL.entno, adr );
  239.                 var.adr := OPL.entno;
  240.                 INC( OPL.entno );
  241.             END; (* IF *)
  242.             var.linkadr := adr;
  243.             var := var.link
  244.         END; (* WHILE *)
  245.         dsize := -adr;
  246.         Align( dsize, 8 );
  247.     END VarAdr;
  248.     PROCEDURE Traverse( obj : OPT.Object; exported : BOOLEAN );
  249.     (* Completes types and procedures. *)
  250.         VAR typ: OPT.Struct;
  251.         PROCEDURE TraverseRecord( typ : OPT.Struct );
  252.         (* Inserts the type descriptor address into the types and the method numbers into the methods. *)
  253.         BEGIN
  254.             IF typ.tdadr = OPM.TDAdrUndef THEN
  255.                 IF typ.BaseTyp # NIL THEN
  256.                     TraverseRecord( typ.BaseTyp );
  257.                     typ.n := typ.BaseTyp.n;
  258.                 END; (* IF *)
  259.                 Traverse( typ.link, FALSE ); (* traverse methods *)
  260.                 OPL.AllocTypDesc( typ );
  261.             END; (* IF *)
  262.         END TraverseRecord;
  263.     BEGIN (* Traverse *)
  264.         IF obj # NIL THEN
  265.             Traverse( obj.left, exported );
  266.             IF ( obj.mode = Typ ) & ( ( obj.vis # internal ) = exported ) THEN
  267.                 typ := obj.typ;
  268.                 TypSize( typ, FALSE );
  269.                 IF typ.form = Pointer THEN typ := typ.BaseTyp END;
  270.                 IF typ.comp = Record THEN TraverseRecord( typ ) END;
  271.             ELSIF obj.mode IN {LProc, XProc, TProc, CProc, IProc} THEN
  272.                 ProcSize( obj, exported )
  273.             END ;
  274.             Traverse( obj.right, exported )
  275.         END
  276.     END Traverse;
  277.     PROCEDURE AdrAndSize*;
  278.     (* Completes the symbol table: types, variables, record-fields and procedures. *)
  279.     BEGIN (* AdrAndSize *)
  280.         OPL.dsize := 0;
  281.         VarAdr( OPT.topScope.scope, OPL.dsize );
  282.         OPM.errpos := OPT.topScope.adr;    (* text position of the scope *)
  283.         Traverse( OPT.topScope.right, TRUE );  (* first run for all exported types and procedures *)
  284.         Traverse( OPT.topScope.right, FALSE );  (* second run for all local types and procedures *)
  285.     END AdrAndSize;
  286.     PROCEDURE BaseTyp( typ : OPT.Struct ) : OPT.Struct;
  287.     (* Returns the record type belonging to typ. *)
  288.     BEGIN (* BaseTyp *)
  289.         IF typ.form = Pointer THEN RETURN typ.BaseTyp
  290.         ELSE RETURN typ
  291.         END
  292.     END BaseTyp;
  293.     PROCEDURE ^Expr( node : OPT.Node; VAR res : OPL.Item );
  294.     PROCEDURE Designator( node : OPT.Node; VAR res : OPL.Item );
  295.     (* Returns an item for a designator. res.mode is in { regx, pcx }. *)
  296.         VAR index, tag : OPL.Item;
  297.     BEGIN (* Designator *)
  298.         CASE node.class OF
  299.             Nvar, Nvarpar :
  300.                 OPC.MakeVar( node.obj, res );
  301.             | Nfield :
  302.                 Designator( node.left, res );
  303.                 OPC.MakeField( res, node.obj.adr, node.typ );
  304.             | Nderef :
  305.                 Designator( node.left, res );
  306.                 OPC.DeRef( node.typ, res );
  307.             | Nindex :
  308.                 Expr( node.right, index );
  309.                 Designator( node.left, res );
  310.                 OPC.MakeIndex( index, res );
  311.             | Nguard, Neguard :
  312.                 Designator( node.left, res );
  313.                 IF typCheck THEN
  314.                     OPC.saveRegs:=FALSE;
  315.                     OPC.MakeTag( node.left.obj, node.left.typ, res, tag );
  316.                     OPC.TypeTest( tag, BaseTyp( node.typ ), TRUE, node.class = Neguard );
  317.                     OPC.saveRegs:=TRUE;
  318.                 END; (* IF *)
  319.             | Nproc :
  320.                 OPC.MakeProc( node.obj, node.subcl, res );
  321.         END; (* CASE *)
  322.         res.typ := node.typ;
  323.     END Designator;
  324.     PROCEDURE AllocParams( formalPar : OPT.Object; VAR psize : LONGINT );
  325.     (* Allocates space on the stack for the parameters and increments psize by their size. *)
  326.     BEGIN (* AllocParams *)
  327.         WHILE formalPar # NIL DO
  328.             IF formalPar.mode = VarPar THEN
  329.                 IF formalPar.typ.comp = Record THEN INC( psize, RecVarParSize )
  330.                 ELSIF formalPar.typ.comp = DynArr THEN INC( psize, formalPar.typ.size )
  331.                 ELSE INC( psize, VarParSize )
  332.                 END;
  333.             ELSE
  334.                 INC( psize, formalPar.typ.size );
  335.             END; (* IF *)
  336.             Align( psize, 4 );
  337.             formalPar := formalPar.link;
  338.         END; (* WHILE *)
  339.         OPC.AddToSP( -psize );
  340.     END AllocParams;
  341.     PROCEDURE AssignParams( formalPar : OPT.Object; actualPar : OPT.Node );
  342.     (* Moves the actual parameters to the stack. *)
  343.         VAR par, par1, tag : OPL.Item;
  344.     BEGIN (* AssignParams *)
  345.         WHILE formalPar # NIL DO
  346.             IF formalPar.typ.comp = DynArr THEN
  347.                 Expr( actualPar, par );
  348.                 OPC.MoveDynArrStack( formalPar.typ, formalPar.adr - ProcOff, par );
  349.             ELSIF formalPar.mode = VarPar THEN
  350.                 Designator( actualPar, par );
  351.                 par1 := par;
  352.                 OPC.MoveAdrStack( formalPar.adr - ProcOff, par );
  353.                 IF formalPar.typ.comp = Record THEN
  354.                     OPC.MakeTag( actualPar.obj, actualPar.typ, par, tag );
  355.                     OPC.MoveStack( formalPar.adr + 4 - ProcOff, tag );
  356.                 ELSIF ( formalPar.typ = OPT.sysptrtyp ) & ( actualPar.typ # OPT.sysptrtyp ) THEN
  357.                     (* pass static type to enable run time tests *)
  358.                     OPC.StaticTag( actualPar.typ.BaseTyp, tag );
  359.                     OPC.Assign( tag, par1 );
  360.                 ELSIF ( formalPar.typ = OPT.sysptrtyp ) & ( actualPar.typ = OPT.sysptrtyp ) & ( actualPar.obj.mode # VarPar ) THEN
  361.                     (* pass NIL to disable run time tests *)
  362.                     OPC.MakeIntConst( 0, OPT.linttyp, tag );
  363.                     OPC.Assign( tag, par1 );
  364.                 END; (* IF *)
  365.             ELSE
  366.                 par.tJump := OPL.NewLabel;
  367.                 par.fJump := OPL.NewLabel;
  368.                 Expr( actualPar, par );
  369.                 OPC.Convert( par, formalPar.typ );
  370.                 OPC.MoveStack( formalPar.adr - ProcOff, par );
  371.             END; (* IF *)
  372.             OPL.usedRegs := { };
  373.             actualPar := actualPar.link;
  374.             formalPar := formalPar.link;
  375.         END; (* WHILE *)
  376.     END AssignParams;
  377.     PROCEDURE Expr( node : OPT.Node; VAR res : OPL.Item );
  378.     (* Returns an item for the result of an exression. *)
  379.         VAR expr1, expr2, expression, set, element, procItem, arr, tag : OPL.Item;
  380.                 swap : OPL.Label;
  381.                 savedRegs : SET;
  382.                 psize : LONGINT;
  383.     BEGIN (* Expr *)
  384.         CASE node.class OF
  385.             Nconst :
  386.                 OPC.MakeConst( node.obj, node.conval, node.typ, res );
  387.             | Nupto :
  388.                 Expr( node.left, expr1 );
  389.                 Expr( node.right, expr2 );
  390.                 OPC.UpTo( expr1, expr2, res );
  391.             | Nmop :
  392.                 CASE node.subcl OF
  393.                     not :
  394.                         swap := res.tJump;
  395.                         res.tJump := res.fJump;
  396.                         res.fJump := swap;
  397.                         Expr( node.left, res );
  398.                         swap := res.tJump;
  399.                         res.tJump := res.fJump;
  400.                         res.fJump := swap;
  401.                         OPC.Not( res );
  402.                     | minus :
  403.                         Expr( node.left, res );
  404.                         OPC.Neg( res );
  405.                     | is :
  406.                         Designator( node.left, res );
  407.                         tag.tJump := res.tJump;
  408.                         tag.fJump := res.fJump;
  409.                         OPC.saveRegs:=FALSE;
  410.                         OPC.MakeTag( node.left.obj, node.left.typ, res, tag );
  411.                         OPC.TypeTest( tag, BaseTyp( node.obj.typ ), FALSE, FALSE );
  412.                         OPC.saveRegs:=TRUE;
  413.                         res := tag;
  414.                     | conv :
  415.                         Expr( node.left, res );
  416.                         IF node.typ.form = Set THEN
  417.                             OPC.SetElem( res );
  418.                         ELSE
  419.                             OPC.Convert( res, node.typ );
  420.                         END; (* IF *)
  421.                     | abs :
  422.                         Expr( node.left, res );
  423.                         OPC.Abs( res );
  424.                     | cap :
  425.                         Expr( node.left, res );
  426.                         OPC.Cap( res );
  427.                     | odd :
  428.                         Expr( node.left, res );
  429.                         OPC.Odd( res );
  430.                     | adr :
  431.                         Expr( node.left, res );
  432.                         OPC.Adr( res );
  433.                     | cc :
  434.                         OPC.MakeCocItem( SHORT( node.left.conval.intval ), res );
  435.                     | val :
  436.                         res.tJump := OPL.NewLabel;
  437.                         res.fJump := OPL.NewLabel;
  438.                         Expr( node.left, res );
  439.                         IF res.typ.comp = DynArr THEN OPC.GetDynArrVal( res ); END;
  440.                         res.typ := node.typ;
  441.                 END; (* CASE *)
  442.             | Ndop :
  443.                 CASE node.subcl OF
  444.                     times :
  445.                         Expr( node.left, expression );
  446.                         Expr( node.right, res );
  447.                         OPC.Mul( node.typ, expression, res );
  448.                     | slash :
  449.                         Expr( node.left, res );
  450.                         Expr( node.right, expression );
  451.                         OPC.Divide( node.typ, expression, res );
  452.                     | div :
  453.                         Expr( node.left, res );
  454.                         Expr( node.right, expression );
  455.                         OPC.Div( expression, res );
  456.                     | mod :
  457.                         Expr( node.left, res );
  458.                         Expr( node.right, expression );
  459.                         OPC.Mod( expression, res );
  460.                     | and :
  461.                         savedRegs := OPL.usedRegs;
  462.                         expression.tJump := OPL.NewLabel;
  463.                         expression.fJump := res.fJump;
  464.                         Expr( node.left, expression );
  465.                         OPC.FalseJump( expression, expression.fJump );
  466.                         OPL.usedRegs := savedRegs;
  467.                         Expr( node.right, res );
  468.                         OPC.Test( res );
  469.                         res.fJump := OPL.MergedLinks( expression.fJump, res.fJump );
  470.                     | plus :
  471.                         Expr( node.left, res );
  472.                         Expr( node.right, expression );
  473.                         OPC.Plus( node.typ, expression, res );
  474.                     | minus :
  475.                         Expr( node.left, res );
  476.                         Expr( node.right, expression );
  477.                         OPC.Minus( node.typ, expression, res );
  478.                     | or : 
  479.                         savedRegs := OPL.usedRegs;
  480.                         expression.tJump := res.tJump;
  481.                         expression.fJump := OPL.NewLabel;
  482.                         Expr( node.left, expression );
  483.                         OPC.TrueJump( expression, expression.tJump );
  484.                         OPL.usedRegs := savedRegs;
  485.                         Expr( node.right, res );
  486.                         OPC.Test( res );
  487.                         res.tJump := OPL.MergedLinks( expression.tJump, res.tJump );
  488.                     | eql, neq, lss, leq, gtr, geq :
  489.                         expr1.tJump := OPL.NewLabel;
  490.                         expr1.fJump := OPL.NewLabel;
  491.                         expr2.tJump := OPL.NewLabel;
  492.                         expr2.fJump := OPL.NewLabel;
  493.                         Expr( node.left, expr1 );
  494.                         OPC.LoadCC( expr1 );
  495.                         Expr( node.right, expr2 );
  496.                         OPC.Compare( node.subcl, expr1, expr2, res );
  497.                     | in :
  498.                         Expr( node.left, element );
  499.                         Expr( node.right, set );
  500.                         OPC.In( element, set, res );
  501.                     | ash :
  502.                         Expr( node.left, res );
  503.                         Expr( node.right, expression );
  504.                         OPC.Shift( ASh, expression, res );
  505.                     | msk :
  506.                         Expr( node.left, res );
  507.                         OPC.Mask( -node.right.conval.intval-1, res );
  508.                     | len :
  509.                         Designator( node.left, arr );
  510.                         OPC.MakeLen( arr, node.right.conval.intval, res );
  511.                     | bit :
  512.                         Expr( node.left, expr1 );
  513.                         Expr( node.right, expr2 );
  514.                         OPC.SYSBit( expr1, expr2, res );
  515.                     | lsh :
  516.                         Expr( node.left, res );
  517.                         Expr( node.right, expression );
  518.                         OPC.Shift( LSh, expression, res );
  519.                     | rot :
  520.                         Expr( node.left, res );
  521.                         Expr( node.right, expression );
  522.                         OPC.Shift( ROt, expression, res );
  523.                 END; (* CASE *)
  524.             | Ncall :
  525.                 savedRegs := OPL.usedRegs;
  526.                 OPC.PushRegs( OPL.usedRegs );
  527.                 OPL.usedRegs := { };
  528.                 IF ( node.left.obj # NIL ) & ( node.left.obj.mode = LProc ) & ( node.left.obj.mnolev > 0 ) THEN
  529.                     psize := OPM.PointerSize; (* for static link *)
  530.                 ELSE
  531.                     psize := 0;
  532.                 END;
  533.                 AllocParams( node.obj, psize );
  534.                 OPC.WriteStaticLink( node.left.obj );
  535.                 AssignParams( node.obj, node.right );
  536.                 Designator( node.left, procItem );
  537.                 OPC.Call( procItem, node.left.obj );
  538.                 OPC.AddToSP( psize );
  539.                 OPL.usedRegs := savedRegs;
  540.                 OPC.GetResult( node.left.typ, res );
  541.                 OPC.PopRegs( savedRegs );
  542.         ELSE
  543.             Designator( node, res );
  544.         END; (* CASE *)
  545.         res.typ := node.typ;
  546.     END Expr;
  547.     PROCEDURE Checkpc;
  548.     BEGIN
  549.         IF findpc & (OPL.pc > OPM.breakpc) & OPM.noerr THEN OPM.err(255) END
  550.         (* in the case of a call, the breakpc value shown in the trap viewer must point to the call instruction
  551.             and not to the next instruction, i.e. breakpc # return address !! *)
  552.     END Checkpc;
  553.     PROCEDURE StatSeq( node : OPT.Node );
  554.     (* Generates code for a statement sequence. *)
  555.         VAR proc : OPT.Object;
  556.                 designator, expression, sourceAdr, destAdr, procItem, reg, tag : OPL.Item;
  557.                 begLabel, savedLoopEnd : OPL.Label;
  558.                 psize : LONGINT;
  559.         PROCEDURE CaseStatement( node : OPT.Node );
  560.         (* Generates code for a case statement. *)
  561.             VAR expression : OPL.Item;
  562.                     lo, hi, i, jtAdr : LONGINT;
  563.                     elseLabel, endLabel : OPL.Label;
  564.                     case, caseLabel : OPT.Node;
  565.         BEGIN (* CaseStatement *)
  566.             Expr( node.left, expression );
  567.             node := node.right;
  568.             lo := node.conval.intval;
  569.             hi := node.conval.intval2;
  570.             IF hi >= lo THEN
  571.                 elseLabel := OPL.NewLabel;
  572.                 endLabel := OPL.NewLabel;
  573.                 OPC.Case( expression, lo, hi, elseLabel, jtAdr );
  574.                 FOR i := 0 TO hi - lo DO OPL.ConstWord( SHORT( jtAdr + 2 * i ), OPL.pc DIV 2 ); END;
  575.                 OPL.DefineLabel( elseLabel );
  576.             END; (* IF *)
  577.             Checkpc;
  578.             IF node.conval.setval = { } THEN
  579.                 OPC.Trap( CaseTrap );
  580.             ELSE
  581.                 StatSeq( node.right );
  582.             END;
  583.             IF hi >= lo THEN
  584.                 case := node.left;
  585.                 WHILE case # NIL DO
  586.                     OPL.Jump( true, endLabel );
  587.                     caseLabel := case.left;
  588.                     WHILE caseLabel # NIL DO
  589.                         FOR i := caseLabel.conval.intval - lo TO caseLabel.conval.intval2 - lo DO
  590.                             OPL.ConstWord( SHORT( jtAdr + 2 * i ), OPL.pc DIV 2 ); 
  591.                         END; (* FOR *)
  592.                         caseLabel := caseLabel.link;
  593.                     END; (* WHILE *)
  594.                     StatSeq( case.right );
  595.                     case := case.link;
  596.                 END; (* WHILE *)
  597.                 OPL.DefineLabel( endLabel );
  598.             END; (* IF *)
  599.         END CaseStatement;
  600.         PROCEDURE IfStatement( node : OPT.Node; trap : BOOLEAN );
  601.         (* Generates code for an IF-Statement. If trap is true, a Trap is generated in the ELSE-Case. *)
  602.             VAR endLabel : OPL.Label;
  603.                     curNode : OPT.Node;
  604.                     expression : OPL.Item;
  605.         BEGIN (* IfStatement *)
  606.             endLabel := OPL.NewLabel;
  607.             curNode := node.left;
  608.             WHILE curNode # NIL DO
  609.                 expression.tJump := OPL.NewLabel;
  610.                 expression.fJump := OPL.NewLabel;
  611.                 Expr( curNode.left, expression );
  612.                 OPC.FalseJump( expression, expression.fJump ); Checkpc;
  613.                 StatSeq( curNode.right );
  614.                 IF ( curNode.link # NIL ) OR ( node.right # NIL ) OR trap THEN
  615.                 (* last ELSIF part with no ELSE following *)
  616.                     OPL.Jump( true, endLabel );
  617.                 END;
  618.                 OPL.DefineLabel( expression.fJump );
  619.                 curNode := curNode.link;
  620.             END; (* WHILE *)
  621.             IF trap THEN
  622.                 OPC.Trap( WithTrap );
  623.             ELSE
  624.                 StatSeq( node.right );
  625.             END; (* IF *)
  626.             OPL.DefineLabel( endLabel );
  627.         END IfStatement;
  628.         PROCEDURE Size( typ : OPT.Struct; node : OPT.Node; VAR res : OPL.Item );
  629.         (* Returns an item that denotes the size of the memory space in bytes that has to be allocated for a dynamic array. *)
  630.             VAR dim, offsetItem : OPL.Item;
  631.                     noflen : INTEGER;
  632.         BEGIN (* Size *)
  633.             Expr( node, res );
  634.             noflen := 1;
  635.             node := node.link;
  636.             typ := typ.BaseTyp.BaseTyp;
  637.             WHILE node # NIL DO
  638.                 Expr( node, dim );
  639.                 INC( noflen );
  640.                 OPC.Mul( OPT.linttyp, dim, res );
  641.                 node := node.link;
  642.                 typ := typ.BaseTyp;
  643.             END; (* WHILE *)
  644.             IF typ.size > 1 THEN
  645.                 OPC.MakeIntConst( typ.size, OPT.linttyp, dim );
  646.                 OPC.Mul( OPT.linttyp, dim, res );
  647.             END; (* IF *)
  648.             OPC.MakeIntConst( 4 * noflen, OPT.linttyp, offsetItem );
  649.             OPC.Plus( OPT.linttyp, offsetItem, res );
  650.         END Size;
  651.         PROCEDURE EnterLengths( VAR item : OPL.Item; node : OPT.Node );
  652.         (* Writes the lengths in node to the address in item. Used for NEW( p, len1, len2, ... ). *)
  653.             VAR length, adr : OPL.Item;
  654.         BEGIN (* EnterLengths *)
  655.             adr := item;
  656.             OPC.DeRef( OPT.sysptrtyp, adr );
  657.             WHILE node # NIL DO
  658.                 Expr( node, length );
  659.                 OPC.Convert( length, OPT.linttyp );
  660.                 OPL.Move( length, adr );
  661.                 INC( adr.bd, 4 );
  662.                 node := node.link;
  663.             END; (* WHILE *)
  664.         END EnterLengths;
  665.         PROCEDURE Prepend( s : ARRAY OF CHAR );
  666.         (* Writes the given name in parentheses to the reference file. *)
  667.             VAR i : INTEGER;
  668.                     ch : CHAR;
  669.         BEGIN (* Prepend *)
  670.             i := 0;
  671.             ch := s[ 0 ];
  672.             OPM.RefW( "(" );
  673.             WHILE ch # 0X DO
  674.                 OPM.RefW( ch );
  675.                 INC( i );
  676.                 ch := s[ i ];
  677.             END; (* WHILE *)
  678.             OPM.RefW( ")" );
  679.         END Prepend;
  680.     BEGIN (* StatSeq *)
  681.         WHILE ( node # NIL ) & OPM.noerr DO
  682.             OPM.errpos := node.conval.intval;
  683.             OPL.BegStat;
  684.             CASE node.class OF
  685.                 Nenter :
  686.                     IF node.obj = NIL THEN (* module *)
  687.                         OPC.EnterMod;
  688.                         StatSeq( node.right );
  689.                         OPC.Return( NIL, FALSE, expression );
  690.                         OPL.OutRefPoint;
  691.                         OPL.OutRefName( "$" );
  692.                         OPL.OutRefs( OPT.topScope );
  693.                         INC( OPL.level );
  694.                         StatSeq( node.left );
  695.                         DEC( OPL.level );
  696.                     ELSE (* procedure *)
  697.                         proc := node.obj;
  698.                         INC( OPL.level );
  699.                         StatSeq( node.left );
  700.                         DEC( OPL.level );
  701.                         OPC.EnterProc( proc );
  702.                         StatSeq( node.right );
  703.                         IF proc.typ # OPT.notyp THEN OPC.Trap( FuncTrap );
  704.                         ELSE OPC.Return( proc, FALSE, expression );
  705.                         END;
  706.                         OPL.OutRefPoint;
  707.                         IF proc^.mode = TProc THEN Prepend( proc^.link^.typ^.strobj^.name ) END;
  708.                         OPL.OutRefName( proc^.name );
  709.                         OPL.OutRefs( proc^.scope^.right );
  710.                     END; (* IF *)
  711.                 | Ninittd :
  712.                 | Nassign :
  713.                     CASE node.subcl OF
  714.                         assign :
  715.                             expression.tJump := OPL.NewLabel;
  716.                             expression.fJump := OPL.NewLabel;
  717.                             Expr( node.right, expression );
  718.                             OPC.LoadCC( expression );
  719.                             Designator( node.left, designator );
  720.                             OPC.Assign( expression, designator );
  721.                         | newfn :
  722.                             Designator( node.left, designator );
  723.                             OPL.LoadAdr( designator );
  724.                             IF node.right = NIL THEN
  725.                                 IF node.left.typ.BaseTyp.comp = Record THEN
  726.                                     OPC.StaticTag( node.left.typ.BaseTyp, tag );
  727.                                     OPC.New( designator, tag );
  728.                                 ELSE
  729.                                     OPC.MakeIntConst( node.left.typ.BaseTyp.size, OPT.linttyp, expression );
  730.                                     OPC.SYSNew( designator, expression );
  731.                                 END; (* IF *)
  732.                             ELSE
  733.                                 Size( node.left.typ, node.right, expression );
  734.                                 OPC.SYSNew( designator, expression );
  735.                                 EnterLengths( designator, node.right );
  736.                             END; (* IF *)
  737.                         | incfn :
  738.                             Expr( node.right, expression );
  739.                             Designator( node.left, designator );
  740.                             OPL.LoadAdr( designator );
  741.                             OPC.Increment( designator, expression );
  742.                         | decfn :
  743.                             Expr( node.right, expression );
  744.                             Designator( node.left, designator );
  745.                             OPL.LoadAdr( designator );
  746.                             OPC.Decrement( designator, expression );
  747.                         | inclfn :
  748.                             Expr( node.right, expression );
  749.                             Designator( node.left, designator );
  750.                             OPL.LoadAdr( designator );
  751.                             OPC.Include( designator, expression );
  752.                         | exclfn :
  753.                             Expr( node.right, expression );
  754.                             Designator( node.left, designator );
  755.                             OPL.LoadAdr( designator );
  756.                             OPC.Exclude( designator, expression );
  757.                         | copyfn :
  758.                             Expr( node.right, expression );
  759.                             Designator( node.left, designator );
  760.                             OPC.Copy( expression, designator );
  761.                         | getfn :
  762.                             Expr( node.right, sourceAdr );
  763.                             Designator( node.left, designator );
  764.                             OPL.LoadAdr( designator );
  765.                             OPC.SYSGet( sourceAdr, designator );
  766.                         | putfn :
  767.                             Expr( node.left, destAdr );
  768.                             Expr( node.right, expression );
  769.                             OPC.SYSPut( expression, destAdr );
  770.                         | getrfn :
  771.                             OPC.MakeConst( node.obj, node.right.conval, OPT.inttyp, reg );
  772.                             Designator( node.left, designator );
  773.                             OPL.LoadAdr( designator );
  774.                             OPC.SYSGetReg( designator, reg );
  775.                         | putrfn :
  776.                             OPC.MakeConst( node.obj, node.left.conval, OPT.inttyp, reg );
  777.                             Expr( node.right, expression );
  778.                             OPC.SYSPutReg( expression, reg );
  779.                         | sysnewfn :
  780.                             Designator( node.left, designator );
  781.                             OPL.LoadAdr( designator );
  782.                             Expr( node.right, expression );
  783.                             OPC.SYSNew( designator, expression );
  784.                         | movefn :
  785.                             Expr( node.left, sourceAdr );
  786.                             Expr( node.right, destAdr );
  787.                             Expr( node.right.link, expression );
  788.                             OPC.SYSMove( destAdr, sourceAdr, expression );
  789.                     END; (* CASE *)
  790.                 | Ncall :
  791.                     IF ( node.left.obj # NIL ) & ( node.left.obj.mode = LProc ) & ( node.left.obj.mnolev > 0 ) THEN
  792.                         psize := OPM.PointerSize; (* for static link *)
  793.                     ELSE
  794.                         psize := 0;
  795.                     END;
  796.                     AllocParams( node.obj, psize );
  797.                     OPC.WriteStaticLink( node.left.obj );
  798.                     AssignParams( node.obj, node.right );
  799.                     Designator( node.left, procItem );
  800.                     OPC.Call( procItem, node.left.obj );
  801.                     OPC.AddToSP( psize );
  802.                 | Nifelse :
  803.                     IF ( node^.subcl # assertfn ) OR assert THEN IfStatement( node, FALSE ); END;
  804.                 | Ncase :
  805.                     CaseStatement( node );
  806.                 | Nwhile :
  807.                     begLabel := OPL.NewLabel;
  808.                     OPL.DefineLabel( begLabel );
  809.                     expression.tJump := OPL.NewLabel;
  810.                     expression.fJump := OPL.NewLabel;
  811.                     Expr( node.left, expression );
  812.                     OPC.FalseJump( expression, expression.fJump );
  813.                     StatSeq( node.right );
  814.                     OPL.Jump( true, begLabel );
  815.                     OPL.DefineLabel( expression.fJump );
  816.                 | Nrepeat :
  817.                     expression.tJump := OPL.NewLabel;
  818.                     expression.fJump := OPL.NewLabel;
  819.                     OPL.DefineLabel( expression.fJump );
  820.                     StatSeq( node.left );
  821.                     OPL.BegStat;
  822.                     Expr( node.right, expression );
  823.                     OPC.FalseJump( expression, expression.fJump );
  824.                 | Nloop :
  825.                     savedLoopEnd := loopEnd;
  826.                     begLabel := OPL.NewLabel;
  827.                     loopEnd := OPL.NewLabel;
  828.                     OPL.DefineLabel( begLabel );
  829.                     StatSeq( node.left );
  830.                     OPL.Jump( true, begLabel );
  831.                     OPL.DefineLabel( loopEnd );
  832.                     loopEnd := savedLoopEnd;
  833.                 | Nexit :
  834.                     OPL.Jump( true, loopEnd );
  835.                 | Nreturn :
  836.                     IF node.left # NIL THEN
  837.                         expression.tJump := OPL.NewLabel;
  838.                         expression.fJump := OPL.NewLabel;
  839.                         Expr( node.left, expression )
  840.                     END;
  841.                     OPC.Return( node.obj, node.left # NIL, expression );
  842.                 | Nwith :
  843.                     IfStatement( node, node.subcl = 0 );
  844.                 | Ntrap :
  845.                     IF node.right.conval.intval = 0 THEN node.right.conval.intval := 14 END ; (* should be parameter for front end*)
  846.                     OPC.Trap( SHORT( node.right.conval.intval ) );
  847.             END; (* CASE *)
  848.             Checkpc;
  849.             node := node.link;
  850.         END; (* WHILE *)
  851.     END StatSeq;
  852.     PROCEDURE Module*( prog : OPT.Node );
  853.     BEGIN
  854.         StatSeq( prog )
  855.     END Module;
  856. END OPV.
  857.